home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / pdoxde / pxengwin.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  15.2 KB  |  402 lines
  1. '******* Declarations for Using the Paradox 3.5 Engine ******
  2.  
  3. 'initialize engine connection
  4. Declare Function PXWinInit Lib "Pxengwin.dll" (ByVal Application$, ByVal Mode%) As Integer
  5.  
  6. 'exit and deallocate
  7. Declare Function PXExit Lib "Pxengwin.dll" () As Integer
  8.  
  9. 'open table for access; return table handle
  10. Declare Function PXTblOpen Lib "Pxengwin.dll" (ByVal TblName$, TblHnd%, ByVal index%, ByVal change%) As Integer
  11.  
  12. 'close access to table
  13. Declare Function PXTblClose Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  14.  
  15. 'create empty table
  16. Declare Function PXTblCreate Lib "Pxengwin.dll" (ByVal TblName$, ByVal nFields%, FldNames As Any, FldTypes As Any) As Integer
  17.  
  18. 'delete table and its family
  19. Declare Function PXTblDelete Lib "Pxengwin.dll" (ByVal TblName$) As Integer
  20.  
  21. 'append record to end of database
  22. Declare Function PXRecAppend Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  23.  
  24. 'insert record into database
  25. Declare Function PXRecInsert Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  26.  
  27. 'update current record
  28. Declare Function PXRecUpdate Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  29.  
  30. 'delete current record
  31. Declare Function PXRecDelete Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  32.  
  33. 'create record buffer for table
  34. Declare Function PXRecBufOpen Lib "Pxengwin.dll" (ByVal TblHnd%, RecHnd%) As Integer
  35.  
  36. 'delete record buffer for table
  37. Declare Function PXRecBufClose Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  38.  
  39. 'clear record buffer to spaces
  40. Declare Function PXRecBufEmpty Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  41.  
  42. 'copy from one rec buffer to another
  43. Declare Function PXRecBufCopy Lib "Pxengwin.dll" (ByVal FromRecHnd%, ByVal ToRecHnd%) As Integer
  44.  
  45. 'get current record into buffer
  46. Declare Function PXRecGet Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  47.  
  48. 'put short value
  49. Declare Function PXPutShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal sValue%) As Integer
  50.  
  51. 'put double value
  52. Declare Function PXPutDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal dValue) As Integer
  53.  
  54. 'put long value
  55. Declare Function PXPutLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal lValue&) As Integer
  56.  
  57. 'put alpha value
  58. Declare Function PXPutAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal aValue$) As Integer
  59.  
  60. 'put blank value
  61. Declare Function PXPutBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%) As Integer
  62.  
  63. 'put date value
  64. Declare Function PXPutDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal inDate As Any) As Integer
  65.  
  66. 'get short value
  67. Declare Function PXGetShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, sValue%) As Integer
  68.  
  69. 'get double value
  70. Declare Function PXGetDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, dValue#) As Integer
  71.  
  72. 'get long value
  73. Declare Function PXGetLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, lValue&) As Integer
  74.  
  75. 'get alpha value
  76. Declare Function PXGetAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal bufSize%, ByVal aValue$) As Integer
  77.  
  78. 'is field blank?
  79. Declare Function PXFldBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal Blank%) As Integer
  80.  
  81. 'get date value
  82. Declare Function PXGetDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, outDate As Any) As Integer
  83.  
  84. 'goto specified record number
  85. Declare Function PXRecGoto Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecNum%) As Integer
  86.  
  87. 'goto first record
  88. Declare Function PXRecFirst Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  89.  
  90. 'goto last record
  91. Declare Function PXRecLast Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  92.  
  93. 'goto next record
  94. Declare Function PXRecNext Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  95.  
  96. 'goto previous record
  97. Declare Function PXRecPrev Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  98.  
  99. 'add index to table
  100. Declare Function PXKeyAdd Lib "Pxengwin.dll" (ByVal TblName$, ByVal nFlds%, ByVal FldHand As Any, ByVal Mode%) As Integer
  101.  
  102. 'drop index from table
  103. Declare Function PXKeyDrop Lib "Pxengwin.dll" (ByVal TblName$, ByVal index%) As Integer
  104.  
  105. 'search for a given key
  106. Declare Function PXSrchKey Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal nFlds%, ByVal Mode%) As Integer
  107.  
  108. 'search for a given field
  109. Declare Function PXSrchFld Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal FldNum%, ByVal Mode%) As Integer
  110.  
  111. 'check if table exists
  112. Declare Function PXTblExist Lib "Pxengwin.dll" (ByVal TblName$, ByVal exist%) As Integer
  113.  
  114. 'return current record number
  115. Declare Function PXRecNum Lib "Pxengwin.dll" (ByVal TblHnd%, RecNum%) As Integer
  116.  
  117. 'return number of recs in table
  118. Declare Function PXTblNRecs Lib "Pxengwin.dll" (ByVal TblHnd%, nRecs%) As Integer
  119.  
  120. 'return number of fields in record
  121. Declare Function PXRecNFlds Lib "Pxengwin.dll" (ByVal TblHnd%, nFlds%) As Integer
  122.  
  123. 'return field number of given field name in table
  124. Declare Function PXFldHandle Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldName$, FldHnd%) As Integer
  125.  
  126. 'return field type of given field in table
  127. Declare Function pxFldType Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal fldtype$) As Integer
  128.  
  129. 'return field name of given field in table
  130. Declare Function PXFldName Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal FldName$) As Integer
  131.  
  132. 'return error text associated with error number
  133. Declare Function PXErrMsg Lib "Pxengwin.dll" (ByVal rc%) As String
  134.  
  135. 'decode a date field from table
  136. Declare Function PXDateDecode Lib "Pxengwin.dll" (ByVal outDate&, mm%, dd%, yy%) As Integer
  137.  
  138. 'encode a date to field
  139. Declare Function PXDateEncode Lib "Pxengwin.dll" (ByVal mm%, ByVal dd%, ByVal yy%, pDate&) As Integer
  140.  
  141. Sub GetField (RecHnd%, FldHnd%, fldtype$)
  142.     returnFld = String$(255, 0)
  143.     aValue = ""
  144.     lValue = 0
  145.     dValue = 0
  146.     Select Case Mid$(fldtype$, 1, 1)
  147.         Case Is = "A"
  148.             rc = PXGetAlpha(RecHnd%, FldHnd%, 255, aValue)
  149.             PXError
  150.             returnFld = aValue
  151.         Case Is = "N"
  152.             rc = PXGetLong(RecHnd%, FldHnd%, lValue)
  153.             PXError
  154.             If lValue < 0 Then
  155.                 lValue = 0
  156.             End If
  157.             returnFld = Format$(lValue, "###0")
  158.         Case Is = "$"
  159.             rc = PXGetDoub(RecHnd%, FldHnd%, dValue)
  160.             PXError
  161.             If dValue < 0 Then
  162.                 dValue = 0
  163.             End If
  164.             returnFld = Format$(dValue, "###,##0.00")
  165.         Case Is = "D"
  166.             rc = PXGetDate(RecHnd%, FldHnd%, lValue)
  167.             PXError
  168.             rc = PXDateDecode(lValue, mm, dd, yy)
  169.             returnFld = Format$(lValue, "##/##/##")
  170.     End Select
  171.  
  172. End Sub
  173.  
  174. Sub PutField (RecHnd%, FldHnd%, fldtype$)
  175.     Select Case Mid$(fldtype$, 1, 1)
  176.         Case Is = "A"
  177.             rc = PXPutAlpha(RecHnd%, FldHnd%, aValue)
  178.             PXError
  179.         Case Is = "N"
  180.             rc = PXPutBlank(RecHnd%, FldHnd%)
  181.             PXError
  182.             rc = PXPutLong(RecHnd%, FldHnd%, lValue)
  183.             PXError
  184.         Case Is = "$"
  185.             rc = PXPutBlank(RecHnd%, FldHnd%)
  186.             PXError
  187.             rc = PXPutLong(RecHnd%, FldHnd%, lValue)
  188. '            rc = PXPutDoub(RecHnd%, FldHnd%, dValue)
  189.             PXError
  190.         Case Is = "D"
  191.             rc = PXPutDate(RecHnd%, FldHnd%, lValue)
  192.             PXError
  193.     End Select
  194.  
  195. End Sub
  196.  
  197. Sub PXError ()
  198.     Dim msgbuf As String
  199.     If rc = 0 Then
  200.         Exit Sub
  201.     End If
  202. '   msgbuff = Code + "=" + Str$(rc)
  203. '   msgbuff = PXErrMsg(rc)
  204.     Select Case rc
  205.         Case Is = PXERR_NOTINITERR
  206.             msgbuf = " Engine not initialized"
  207.         Case Is = PXERR_ALREADYINIT
  208.             msgbuf = "Engine already initialized"
  209.         Case Is = PXERR_NOTLOGGEDIN
  210.             msgbuf = " Could not log onto network"
  211.         Case Is = PXERR_NONETINIT
  212.             msgbuf = " Engine not initialized"
  213.         Case Is = PXERR_NETMULTIPLE
  214.             msgbuf = " multiple PARADOX.NET files"
  215.         Case Is = PXERR_CANTSHAREPDOXNET
  216.             msgbuf = " can't lock PARADOX.NET-is SHARE.EXE loaded?"
  217.         Case Is = PXERR_WINDOWSREALMODE
  218.             msgbuf = " can't run Engine in Windows real mode"
  219.         Case Is = PXERR_DRIVENOTREADY
  220.             msgbuf = " Drive not ready"
  221.         Case Is = PXERR_DISKWRITEPRO
  222.             msgbuf = " Disk is write protected"
  223.         Case Is = PXERR_GENERALFAILURE
  224.             msgbuf = " General hardware error"
  225.         Case Is = PXERR_DIRNOTFOUND
  226.             msgbuf = " Directory not found"
  227.         Case Is = PXERR_DIRBUSY
  228.             msgbuf = " Sharing violation-directory busy"
  229.         Case Is = PXERR_DIRLOCKED
  230.             msgbuf = " Sharing violation-directory locked"
  231.         Case Is = PXERR_DIRNOACCESS
  232.             msgbuf = " No access to directory"
  233.         Case Is = PXERR_DIRNOTPRIVATE
  234.             msgbuf = " Single user, but directory is shared"
  235.         Case Is = PXERR_FILEBUSY
  236.             msgbuf = " File is busy"
  237.         Case Is = PXERR_FILELOCKED
  238.             msgbuf = " File is locked"
  239.         Case Is = PXERR_FILENOTFOUND
  240.             msgbuf = " Could not find file"
  241.         Case Is = PXERR_TABLEBUSY
  242.             msgbuf = " Table is busy"
  243.         Case Is = PXERR_TABLELOCKED
  244.             msgbuf = " Table is locked"
  245.         Case Is = PXERR_TABLENOTFOUND
  246.             msgbuf = " Table was not found"
  247.         Case Is = PXERR_TABLEOPEN
  248.             msgbuf = " Unable to perform operation on open table"
  249.         Case Is = PXERR_TABLEINDEXED
  250.             msgbuf = " Table is indexed"
  251.         Case Is = PXERR_TABLENOTINDEXED
  252.             msgbuf = " Table is not indexed"
  253.         Case Is = PXERR_TABLEEMPTY
  254.             msgbuf = " Operation on empty table"
  255.         Case Is = PXERR_TABLEWRITEPRO
  256.             msgbuf = " Table is write protected"
  257.         Case Is = PXERR_TABLECORRUPTED
  258.             msgbuf = " Table is corrupted"
  259.         Case Is = PXERR_TABLEFULL
  260.             msgbuf = " Table is full"
  261.         Case Is = PXERR_TABLESQL
  262.             msgbuf = " Table is SQL replica"
  263.         Case Is = PXERR_INSUFRIGHTS
  264.             msgbuf = " Insufficient password rights"
  265.         Case Is = PXERR_XCORRUPTED
  266.             msgbuf = " Primary index is corrupted"
  267.         Case Is = PXERR_XOUTOFDATE
  268.             msgbuf = " Primary index is out of date"
  269.         Case Is = PXERR_XSORTVERSION
  270.             msgbuf = " Sort for index different from table"
  271.         Case Is = PXERR_SXCORRUPTED
  272.             msgbuf = " Secondary index is corrupted"
  273.         Case Is = PXERR_SXOUTOFDATE
  274.             msgbuf = " Secondary index is out of date"
  275.         Case Is = PXERR_SXNOTFOUND
  276.             msgbuf = " Secondary index was not found"
  277.         Case Is = PXERR_SXOPEN
  278.             msgbuf = " Secondary index is already open"
  279.         Case Is = PXERR_SXCANTUPDATE
  280.             msgbuf = " Can't update table open on non-maintained secondary"                                                                         'maintained secondary"
  281.         Case Is = PXERR_RECTOOBIG
  282.             msgbuf = " Record too big for index"
  283.         Case Is = PXERR_RECDELETED
  284.             msgbuf = " Another user deleted record"
  285.         Case Is = PXERR_RECLOCKED
  286.             msgbuf = " Record is locked"
  287.         Case Is = PXERR_RECNOTFOUND
  288.             msgbuf = " Record was not found"
  289.         Case Is = PXERR_KEYVIOL
  290.             msgbuf = " Key violation"
  291.         Case Is = PXERR_ENDOFTABLE
  292.             msgbuf = " End of table"
  293.         Case Is = PXERR_STARTOFTABLE
  294.             msgbuf = " Start of table"
  295.         Case Is = PXERR_TOOMANYCLIENTS
  296.             msgbuf = " Too many clients"
  297.         Case Is = PXERR_EXCEEDSCONFIGLIMITS
  298.             msgbuf = " Exceeds table conflicts"
  299.         Case Is = PXERR_CANTREMAPFILEHANDLE
  300.             msgbuf = " Cant remap file handle"
  301.         Case Is = PXERR_OUTOFMEM
  302.             msgbuf = " Not enough memory to complete operation"
  303.         Case Is = PXERR_OUTOFDISK
  304.             msgbuf = " Not enough disk space to complete operation"
  305.         Case Is = PXERR_OUTOFSTACK
  306.             msgbuf = " Not enough stack space to complete operation"
  307.         Case Is = PXERR_OUTOFSWAPBUF
  308.             msgbuf = " Not enough swap buffer space to complete operation"
  309.         Case Is = PXERR_OUTOFFILEHANDLES
  310.             msgbuf = " No more file handles available"
  311.         Case Is = PXERR_OUTOFTABLEHANDLES
  312.             msgbuf = " No more table handles"                                                                                    'available
  313.         Case Is = PXERR_OUTOFRECHANDLES
  314.             msgbuf = " No more record handles"                                                                               'available
  315.         Case Is = PXERR_OUTOFLOCKHANDLES
  316.             msgbuf = " Too many locks on table"
  317.         Case Is = PXERR_NOMORETMPNAMES
  318.             msgbuf = " No more temporary names available"
  319.         Case Is = PXERR_TOOMANYPASSW
  320.             msgbuf = " Too many passwords specified"
  321.         Case Is = PXERR_TYPEMISMATCH
  322.             msgbuf = " Data type mismatch"
  323.         Case Is = PXERR_OUTOFRANGE
  324.             msgbuf = " Argument out of range"
  325.         Case Is = PXERR_INVPARAMETER
  326.             msgbuf = " Invalid argument"
  327.         Case Is = PXERR_INVDATE
  328.             msgbuf = " Invalid date given"
  329.         Case Is = PXERR_INVFIELDHANDLE
  330.             msgbuf = " Invalid field handle"
  331.         Case Is = PXERR_INVRECHANDLE
  332.             msgbuf = " Invalid record handle"
  333.         Case Is = PXERR_INVTABLEHANDLE
  334.             msgbuf = " Invalid table handle"
  335.         Case Is = PXERR_INVLOCKHANDLE
  336.             msgbuf = " Invalid lock handle"
  337.         Case Is = PXERR_INVDIRNAME
  338.             msgbuf = " Invalid directory name"
  339.         Case Is = PXERR_INVFILENAME
  340.             msgbuf = " Invalid file name"
  341.         Case Is = PXERR_INVTABLENAME
  342.             msgbuf = " Invalid table name"
  343.         Case Is = PXERR_INVFIELDNAME
  344.             msgbuf = " Invalid field name"
  345.         Case Is = PXERR_INVLOCKCODE
  346.             msgbuf = " Invalid lock code"
  347.         Case Is = PXERR_INVUNLOCK
  348.             msgbuf = " Invalid unlock"
  349.         Case Is = PXERR_INVSORTORDER
  350.             msgbuf = " Invalid sort order table"
  351.         Case Is = PXERR_INVPASSW
  352.             msgbuf = " Invalid password"
  353.         Case Is = PXERR_INVNETTYPE
  354.             msgbuf = " Invalid net type (PXNetInit)"
  355.         Case Is = PXERR_BUFTOOSMALL
  356.             msgbuf = " Buffer too small for result"
  357.         Case Is = PXERR_STRUCTDIFFER
  358.             msgbuf = " Table structures are different"
  359.         Case Is = PXERR_INVENGINESTATE
  360.             msgbuf = " Previous fatal error"
  361.     End Select
  362.     response% = MsgBox(msgbuf, 17, "Paradox Error")
  363.     If response% <> MBOK Then
  364.        rc = PXExit()
  365.        End
  366.     End If
  367.  
  368.        
  369. End Sub
  370.  
  371. Sub PXInit (AppName$, Mode%)
  372.     'mode can be any of: PXSINGLECLIENT,PXEXCLUSIVE,PXSHARED
  373.     rc = PXWinInit(AppName$, Mode%)
  374.     PXError
  375. End Sub
  376.  
  377. Sub PXNext (TblHnd%, RecHnd%)
  378.     rc = PXRecNext(TblHnd%)
  379.     If rc = PXERR_ENDOFTABLE Then
  380.       Exit Sub
  381.     End If
  382.     rc = PXRecGet(TblHnd%, RecHnd%)
  383. End Sub
  384.  
  385. Sub PXOpen (TblName$, TblHnd%, RecHnd%)
  386.     rc = PXTblOpen(TblName$, TblHnd%, tIndex, True)
  387.     PXError
  388.     rc = PXRecBufOpen(TblHnd%, RecHnd%)
  389.     PXError
  390.     rc = PXRecBufEmpty(RecHnd%)
  391.     PXError
  392. End Sub
  393.  
  394. Sub PXPrev (TblHnd%, RecHnd%)
  395.     rc = PXRecPrev(TblHnd)
  396.     If rc = PXERR_STARTOFTABLE Then
  397.       Exit Sub
  398.     End If
  399.     rc = PXRecGet(TblHnd%, RecHnd%)
  400. End Sub
  401.  
  402.